{
  Plug-in Interactive Primitive Creation Tool : Arc Tool.

  Copyright (c) 2008-2012 Luxology LLC

  Permission is hereby granted, free of charge, to any person obtaining a
  copy of this software and associated documentation files (the "Software"),
  to deal in the Software without restriction, including without limitation
  the rights to use, copy, modify, merge, publish, distribute, sublicense,
  and/or sell copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.   Except as contained
  in this notice, the name(s) of the above copyright holders shall not be
  used in advertising or otherwise to promote the sale, use or other dealings
  in this Software without prior written authorization.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  DEALINGS IN THE SOFTWARE.
}

{
  Copyright (c) 2012 David Ballesteros and Jameel Halabi

  This unit is part of the BLAISEmodo wrapper,
  which is licensed under the BSD 2-Clause license (see licenses/license.txt).
}


unit Plugin;

{$mode objfpc}{$H+}

interface

uses
  Lx_Command,
  Lx_Draw   ,
  Lx_Handles,
  Lx_Layer  ,
  Lx_Mesh   ,
  Lx_Message,
  Lx_Result ,
  Lx_Server ,
  Lx_Tool   ,
  Lx_ToolUI ,
  Lx_Value  ,
  Lx_Vector ,
  Lx_VMath  ,
  Lx_VModel ;

const
  ATTRs_CENX    = 'centerX' ;
  ATTRs_CENY    = 'centerY' ;
  ATTRs_CENZ    = 'centerZ' ;
  ATTRs_SRTX    = 'startX'  ;
  ATTRs_SRTY    = 'startY'  ;
  ATTRs_SRTZ    = 'startZ'  ;
  ATTRs_ENDX    = 'endX'    ;
  ATTRs_ENDY    = 'endY'    ;
  ATTRs_ENDZ    = 'endZ'    ;
  ATTRs_RADI    = 'radius'  ;
  ATTRs_ANGL    = 'angle'   ;
  ATTRs_SEGS    = 'segments';
  ATTRs_REVS    = 'reverse' ;

  ATTRa_CENX    = 0 ;
  ATTRa_CENY    = 1 ;
  ATTRa_CENZ    = 2 ;
  ATTRa_SRTX    = 3 ;
  ATTRa_SRTY    = 4 ;
  ATTRa_SRTZ    = 5 ;
  ATTRa_ENDX    = 6 ;
  ATTRa_ENDY    = 7 ;
  ATTRa_ENDZ    = 8 ;
  ATTRa_RADI    = 9 ;
  ATTRa_ANGL    = 10;
  ATTRa_SEGS    = 11;
  ATTRa_REVS    = 12;
  ATTRa_TOTAL   = 13;

  DEF_RADI      = 1.0       ;
  DEF_ANGL      = LXx_HALFPI;
  DEF_SEGS      = 15        ;
  DEF_REVS      = 0         ;

  ARC_HANDLE_CENTER = 10000;
  ARC_HANDLE_START  = 10001;
  ARC_HANDLE_END    = 10002;

type

  { TArcTool }

  TArcTool = class (TLxTool, ILxToolModel   ,
                             ILxAttributes  ,
                             ILxAttributesUI)

    FLayerService : ILxLayerService;
    FVectorType   : ILxVectorType;

    FViewOffset   ,
    FInputOffset  ,
    FEventOffset  ,
    FCenterOffset ,
    FAxisOffset   : UInt32;

    FCenter       ,             // Center Handle
    FStart        ,             // Start Handle
    FEnd          : LXtVector;  // End Handle

    FRadius       ,             // Radius
    FAngle        : Double   ;  // Angle

    FSegments     ,             // Segments
    FReverse      ,             // Reverse
    FPart         ,             // Current part
    FInit         : Integer  ;  // Initial Drag

    constructor
              Create                          ;                    override;

    procedure Reset                           ;                    override;
    procedure Evaluate
              (      VtS         : IUnknown ) ;                    override;
    function  VectorType                      : Pointer          ; override;
    function  Order                           : PChar            ; override;
    function  Task                            : LXtID4           ; override;

    function  Flags                           : UInt32           ;
    procedure Draw
              (      VtS, Stroke : IUnknown ;
                     Flags_      : Integer  ) ;
    procedure Test
              (      VtS, Stroke : IUnknown ;
                     Flags_      : Integer  ) ;
    procedure Filter
              (      VtS         : IUnknown ) ;
    procedure Initialize
              (      VtS, Adjust : IUnknown ;
                     Flags_      : UInt32   ) ;
    function  Down
              (      VtS, Adjust : IUnknown ) : LxResult         ;
    procedure Move
              (      VtS, Adjust : IUnknown ) ;
    procedure Up
              (      VtS, Adjust : IUnknown ) ;
    function  Haul
              (      Index       : UInt32   ) : PChar            ;
    function  Help
              (      VtS         : IUnknown ) : PChar            ;
    function  Enable
              (      Msg         : IUnknown ) : LxResult         ;
    function  Drop                            : LxResult         ;

    function  Count_                          : UInt32           ;
    function  Name
              (      Index       : UInt32   ;
               const Name_       : PPChar   ) : LxResult         ;
    function  Lookup
              (const Name_       : PChar    ;
                     Index       : PUInt32  ) : LxResult         ;
    function  Type_
              (      Index       : UInt32   ;
                     Type__      : PUInt32  ) : LxResult         ;
    function  TypeName
              (      Index       : UInt32   ;
               const Name_       : PPChar   ) : LxResult         ;
    function  Hints
              (      Index       : UInt32   ) : PLXtTextValueHint;
    function  Value
              (      Index       : UInt32   ;
                 out VObj                   ;
                     WriteOK     : Integer  ) : Integer          ;
    function  GetInt
              (      Index       : UInt32   ;
                     Val         : PInteger ) : LxResult         ;
    function  SetInt
              (      Index       : UInt32   ;
                     Val         : Integer  ) : LxResult         ;
    function  GetFlt
              (      Index       : UInt32   ;
                     Val         : PDouble  ) : LxResult         ;
    function  SetFlt
              (      Index       : UInt32   ;
                     Val         : Double   ) : LxResult         ;
    function  GetString
              (      Index       : UInt32   ;
                     Val         : PChar    ;
                     Len         : UInt32   ) : LxResult         ;
    function  SetString
              (      Index       : UInt32   ;
               const Val         : PChar    ) : LxResult         ;

    function  UIHints
              (      Index       : UInt32   ;
                     Hints_      : IUnknown ) : LxResult         ;
    function  UIValueHints
              (      Index       : UInt32   ;
                 out VObj                   ) : LxResult         ;
    function  DisableMsg
              (      Index       : UInt32   ;
                     Msg         : IUnknown ) : LxResult         ;

    procedure DrawHandles
              (      VtS, Stroke : IUnknown ;
                     Flags_      : Integer  ) ;
    procedure SetRadius                       ;
    procedure SetAngle                        ;
    procedure SetRotHandles                   ;
    procedure SetEndHandle                    ;
    procedure GetPos
              (  var Pos         : LXtVector;
               const T           : Double   ;
               const Scale       : Double
                                 = 1.0      ) ;
    procedure PlaneMatrix
              (  out Mat         : LXtMatrix) ;
  end;

implementation

uses
  SysUtils, Math;

{ TArcTool }

constructor TArcTool.Create;
var
  PacketService : ILxPacketService;
begin
  if not Assigned(FLayerService) then
    GetService(ILxLayerService, FLayerService);

  GetService(ILxPacketService, PacketService);

  with PacketService do
  begin
    CreateVectorType(LXsCATEGORY_TOOL, FVectorType);

    AddPacket(FVectorType, LXsP_TOOL_VIEW_EVENT,  LXfVT_GET);
    AddPacket(FVectorType, LXsP_TOOL_INPUT_EVENT, LXfVT_GET);
    AddPacket(FVectorType, LXsP_TOOL_EVENTTRANS,  LXfVT_GET);
    AddPacket(FVectorType, LXsP_TOOL_ACTCENTER,   LXfVT_GET);
    AddPacket(FVectorType, LXsP_TOOL_AXIS,        LXfVT_GET);

    Lookup(LXsCATEGORY_TOOL, LXsP_TOOL_VIEW_EVENT , @FViewOffset  ) ;
    Lookup(LXsCATEGORY_TOOL, LXsP_TOOL_INPUT_EVENT, @FInputOffset ) ;
    Lookup(LXsCATEGORY_TOOL, LXsP_TOOL_EVENTTRANS , @FEventOffset ) ;
    Lookup(LXsCATEGORY_TOOL, LXsP_TOOL_ACTCENTER  , @FCenterOffset) ;
    Lookup(LXsCATEGORY_TOOL, LXsP_TOOL_AXIS       , @FAxisOffset  ) ;
  end;

  Reset;
end;

{
  Reset sets the attributes back to defaults.
}
procedure TArcTool.Reset;
begin
  FCenter   := 0;
  FStart    := Vec(DEF_RADI, 0, 0);
  FEnd      := Vec(0, DEF_RADI, 0);
  FRadius   := DEF_RADI;
  FAngle    := DEF_ANGL;
  FSegments := DEF_SEGS;
  FReverse  := DEF_REVS;
end;

procedure TArcTool.Evaluate(VtS : IUnknown);
var
  I, NumPnts : Integer           ;

  Mesh       : ILxMesh           ;
  MMap       : ILxMeshMap        ;
  NumLayers  : UInt32            ;
  Points     : array of PLXtPoint;
  Pol        : PLXtPolygon       ;
  Poly       : ILxPolygon        ;
  Pos        : LXtVector         ;
  Scan       : ILxLayerScan      ;
  T          : Double            ;
  Vert       : ILxPoint          ;
  View       : PLXpToolViewEvent = nil;

  VectorStack : ILxVectorStack;
begin
  VectorStack := VtS as ILxVectorStack;

  VectorStack.Readable(FViewOffset, View);

  if (not Assigned(View)) or (View^.Type_ <> LXi_VIEWTYPE_3D) then
    Exit;

  {
    Start the Scan to the primary mesh layer.
  }
  FLayerService.ScanAllocate(LXf_LAYERSCAN_PRIMARY   or
                             LXf_LAYERSCAN_WRITEMESH   , Scan);

  with Scan do
  begin

    {
      Check the primary mesh. If no active mesh in the layer,
      we abort the evaluation.
    }
    Count(@NumLayers);

    if NumLayers > 0 then
    begin
      {
        Set the primary mesh to edit.
      }
      MeshEdit(0, Mesh);

      with Mesh as ILxMesh do
      begin
        PointAccessor  (Vert);
        PolygonAccessor(Poly);
        MeshMapAccessor(MMap);
      end;

      {
        Create the arc shape as a face polygon.
      }
      if (FSegments < 1) then
        FSegments := 1;

      NumPnts := FSegments + 2;
      SetLength(Points, NumPnts);

      Vert.New(FCenter, @Points[0]);
      Vert.New(FStart , @Points[1]);

      for I := 0 to FSegments - 1 do
      begin
        T := (I + 1) / FSegments;
        GetPos(Pos, T);
        Vert.New(Pos, @Points[I + 2]);
      end;

      Poly.New(LXiPTYP_FACE, @Points[0], NumPnts, 0, @Pol);

      {
        Apply the edit to the base mesh.
      }
      SetMeshChange(0, LXf_MESHEDIT_GEOMETRY);
      Apply;
    end;

  end;
end;

function TArcTool.VectorType : Pointer;
begin
  Result := FVectorType;
end;

function TArcTool.Order : PChar;
begin
  Result := LXs_ORD_ACTR;
end;

function TArcTool.Task : LXtID4;
begin
  Result := LXi_TASK_ACTR;
end;

{
  We employ a combination of event-based input and hauling. I0 input events
  (left mouse button ) are handled through event callbacks. I1 input events
  (right mouse button) are treated as hauling, which affects the radius.
}
function TArcTool.Flags : UInt32;
begin
  Result := LXfTMOD_I1_ATTRHAUL or
            LXfTMOD_DRAW_3D     or
            LXfTMOD_I0_INPUT;
end;

procedure TArcTool.Draw(VtS, Stroke : IUnknown; Flags_ : Integer);
begin
  DrawHandles(VtS, Stroke, Flags_);
end;

procedure TArcTool.Test(VtS, Stroke : IUnknown; Flags_ : Integer);
begin
  DrawHandles(VtS, Stroke, Flags_);
end;

procedure TArcTool.Filter(VtS : IUnknown);
begin
end;

procedure TArcTool.Initialize(VtS, Adjust : IUnknown; Flags_ : UInt32);
var
  ActionCenter : PLXpToolActionCenter;
  Axis         : PLXpToolAxis        ;

  VectorStack : ILxVectorStack;
  AdjustTool  : ILxAdjustTool;
begin
  VectorStack := VtS as ILxVectorStack;

  with VectorStack do
  begin
    Readable(FCenterOffset, ActionCenter);
    Readable(FAxisOffset  , Axis        );
  end;

  AdjustTool := Adjust as ILxAdjustTool;

  with AdjustTool do
  begin
    {
      Set the initial center position to the action center.
    }
    SetFlt(ATTRa_CENX, ActionCenter^.V[0]);
    SetFlt(ATTRa_CENY, ActionCenter^.V[1]);
    SetFlt(ATTRa_CENZ, ActionCenter^.V[2]);

    {
      Set the initial handle positions to the action Axis.
    }
    SetFlt(ATTRa_SRTX, ActionCenter^.V[0] + Axis^.Right[0] * FRadius);
    SetFlt(ATTRa_SRTY, ActionCenter^.V[1] + Axis^.Right[1] * FRadius);
    SetFlt(ATTRa_SRTZ, ActionCenter^.V[2] + Axis^.Right[2] * FRadius);

    SetFlt(ATTRa_ENDX, ActionCenter^.V[0] + Axis^.Up[0] * FRadius);
    SetFlt(ATTRa_ENDY, ActionCenter^.V[1] + Axis^.Up[1] * FRadius);
    SetFlt(ATTRa_ENDZ, ActionCenter^.V[2] + Axis^.Up[2] * FRadius);

    if FAngle > 0 then
      SetFlt(ATTRa_ANGL, FAngle);

    FInit := 1;
  end;
end;

function TArcTool.Down(VtS, Adjust : IUnknown) : LxResult;
var
  EventPacket : Pointer;
  InputPacket : PLXpToolInputEvent     ;

  VectorStack : ILxVectorStack;
  AdjustTool  : ILxAdjustTool;
begin
  VectorStack := VtS as ILxVectorStack;
  AdjustTool  := Adjust as ILxAdjustTool;

  with VectorStack, AdjustTool do
  begin

    Readable(FInputOffset, InputPacket);
    Readable(FEventOffset, EventPacket);

    with ILxEventTranslatePacket(EventPacket) do

      {
        The first drag.
      }
      if FInit = 1 then

        begin
          HitHandle(VtS, FCenter);
          SetFlt(ATTRa_RADI, 1.0e-6);
        end

      else

        begin
          {
            Set the handle position if a handle is selected.
          }
          FPart := InputPacket^.Part;

          case InputPacket^.Part of
            ARC_HANDLE_CENTER : HitHandle(VtS, FCenter);
            ARC_HANDLE_START  : HitHandle(VtS, FStart );
            ARC_HANDLE_END    : HitHandle(VtS, FEnd   );
          end;
        end;

  end;

  Result := LXe_TRUE;
end;

procedure TArcTool.Move(VtS, Adjust : IUnknown);
var
  EventPacket : Pointer;
  InputPacket : PLXpToolInputEvent;

  Pos         ,
  Delta       ,
  Vector      : LXtVector;

  Scale       : Double;

  VectorStack : ILxVectorStack;
  AdjustTool  : ILxAdjustTool ;
begin
  VectorStack := VtS    as ILxVectorStack;
  AdjustTool  := Adjust as ILxAdjustTool ;

  with VectorStack, AdjustTool do
  begin

    Readable(FInputOffset, InputPacket);
    Readable(FEventOffset, EventPacket);

    with ILxEventTranslatePacket(EventPacket) do

      {
        The first drag
      }
      if FInit = 1 then

        begin
          ModelDelta(VtS, FCenter, Delta);
          SetFlt(ATTRa_RADI, Len(Delta));
        end

      else

        if InputPacket^.Part >= 0 then
        begin

          {
            Get the new handle position.
          }
          GetNewPosition(VtS, Pos);

          case InputPacket^.Part of

            ARC_HANDLE_CENTER : begin
                                  {
                                    Move the three handles together.
                                  }
                                  Delta := Pos - FCenter;
                                  SetFlt(ATTRa_CENX, Pos[0]);
                                  SetFlt(ATTRa_CENY, Pos[1]);
                                  SetFlt(ATTRa_CENZ, Pos[2]);

                                  Pos := FStart + Delta;
                                  SetFlt(ATTRa_SRTX, Pos[0]);
                                  SetFlt(ATTRa_SRTY, Pos[1]);
                                  SetFlt(ATTRa_SRTZ, Pos[2]);

                                  Pos := FEnd + Delta;
                                  SetFlt(ATTRa_ENDX, Pos[0]);
                                  SetFlt(ATTRa_ENDY, Pos[1]);
                                  SetFlt(ATTRa_ENDZ, Pos[2]);
                                end;

            ARC_HANDLE_START  : begin
                                  {
                                    Move the rotation handles together.
                                  }
                                  SetFlt(ATTRa_SRTX, Pos[0]);
                                  SetFlt(ATTRa_SRTY, Pos[1]);
                                  SetFlt(ATTRa_SRTZ, Pos[2]);

                                  if FRadius > 0 then
                                  begin
                                    FStart := Pos;
                                    Vector := FEnd - FCenter;
                                    Scale  := Len(Vector) / FRadius;
                                    GetPos(Pos, 1.0, Scale);
                                  end;

                                  SetFlt(ATTRa_ENDX, Pos[0]);
                                  SetFlt(ATTRa_ENDY, Pos[1]);
                                  SetFlt(ATTRa_ENDZ, Pos[2]);
                                end;

            ARC_HANDLE_END    : begin
                                  {
                                    Move the end handle alone.
                                  }
                                  SetFlt(ATTRa_ENDX, Pos[0]);
                                  SetFlt(ATTRa_ENDY, Pos[1]);
                                  SetFlt(ATTRa_ENDZ, Pos[2]);
                                end;
          end;

        end;

  end;
end;

procedure TArcTool.Up(VtS, Adjust : IUnknown);
begin
  FPart := -1;
  FInit :=  0;
end;

function TArcTool.Haul(Index : UInt32) : PChar;
begin
  if Index = 0 then
    Result := ATTRs_RADI
  else
    Result := nil;
end;

function TArcTool.Help(VtS : IUnknown) : PChar;
begin
  Result := nil;
end;

function TArcTool.Enable(Msg : IUnknown) : LxResult;
begin
  Result := LXe_NOTIMPL;
end;

function TArcTool.Drop : LxResult;
begin
  Result := LXe_NOTIMPL;
end;

function TArcTool.Count_ : UInt32;
begin
  Result := ATTRa_TOTAL;
end;

function TArcTool.Name(Index : UInt32; const Name_ : PPChar) : LxResult;
begin
  Result := LXe_OK;

  case Index of
    ATTRa_CENX : Name_^ := ATTRs_CENX;
    ATTRa_CENY : Name_^ := ATTRs_CENY;
    ATTRa_CENZ : Name_^ := ATTRs_CENZ;

    ATTRa_SRTX : Name_^ := ATTRs_SRTX;
    ATTRa_SRTY : Name_^ := ATTRs_SRTY;
    ATTRa_SRTZ : Name_^ := ATTRs_SRTZ;

    ATTRa_ENDX : Name_^ := ATTRs_ENDX;
    ATTRa_ENDY : Name_^ := ATTRs_ENDY;
    ATTRa_ENDZ : Name_^ := ATTRs_ENDZ;

    ATTRa_RADI : Name_^ := ATTRs_RADI;

    ATTRa_ANGL : Name_^ := ATTRs_ANGL;

    ATTRa_SEGS : Name_^ := ATTRs_SEGS;

    ATTRa_REVS : Name_^ := ATTRs_REVS;
  else
    Result := LXe_OUTOFBOUNDS;
  end;
end;

function TArcTool.Lookup(const Name_ : PChar; Index : PUInt32) : LxResult;
begin
  Result := LXe_OK;

  case String(Name_) of
    ATTRs_CENX : Index^ := ATTRa_CENX;
    ATTRs_CENY : Index^ := ATTRa_CENY;
    ATTRs_CENZ : Index^ := ATTRa_CENZ;

    ATTRs_SRTX : Index^ := ATTRa_SRTX;
    ATTRs_SRTY : Index^ := ATTRa_SRTY;
    ATTRs_SRTZ : Index^ := ATTRa_SRTZ;

    ATTRs_ENDX : Index^ := ATTRa_ENDX;
    ATTRs_ENDY : Index^ := ATTRa_ENDY;
    ATTRs_ENDZ : Index^ := ATTRa_ENDZ;

    ATTRs_RADI : Index^ := ATTRa_RADI;

    ATTRs_ANGL : Index^ := ATTRa_ANGL;

    ATTRs_SEGS : Index^ := ATTRa_SEGS;

    ATTRs_REVS : Index^ := ATTRa_REVS;
  else
    Result := LXe_NOTFOUND;
  end;
end;

function TArcTool.Type_(Index : UInt32; Type__ : PUInt32) : LxResult;
begin
  Result :=  LXe_OK;

  case Index of
    ATTRa_SEGS ,
    ATTRa_REVS : Type__^ := LXi_TYPE_INTEGER;

    ATTRa_CENX ,
    ATTRa_CENY ,
    ATTRa_CENZ ,
    ATTRa_SRTX ,
    ATTRa_SRTY ,
    ATTRa_SRTZ ,
    ATTRa_ENDX ,
    ATTRa_ENDY ,
    ATTRa_ENDZ ,
    ATTRa_RADI ,
    ATTRa_ANGL : Type__^ := LXi_TYPE_FLOAT;
  else
    Result := LXe_OUTOFBOUNDS;
  end;
end;

function TArcTool.TypeName(Index : UInt32; const Name_ : PPChar) : LxResult;
begin
  Result :=  LXe_OK;

  case Index of
    ATTRa_SEGS : Name_^ := LXsTYPE_INTEGER;

    ATTRa_REVS : Name_^ := LXsTYPE_BOOLEAN;

    ATTRa_ANGL : Name_^ := LXsTYPE_ANGLE;

    ATTRa_CENX ,
    ATTRa_CENY ,
    ATTRa_CENZ ,
    ATTRa_SRTX ,
    ATTRa_SRTY ,
    ATTRa_SRTZ ,
    ATTRa_ENDX ,
    ATTRa_ENDY ,
    ATTRa_ENDZ ,
    ATTRa_RADI : Name_^ := LXsTYPE_DISTANCE;
  else
    Result := LXe_OUTOFBOUNDS;
  end;
end;

function TArcTool.Hints(Index : UInt32) : PLXtTextValueHint;
begin
   Result := nil;
end;

function TArcTool.Value(Index : UInt32; out VObj; WriteOK : Integer) : Integer;
begin
  Result := 0;
end;

function TArcTool.GetInt(Index : UInt32; Val : PInteger) : LxResult;
begin
  Result := LXe_OK;

  case Index of
    ATTRa_SEGS : Val^ := FSegments;

    ATTRa_REVS : Val^ := FReverse;
  else
    Result := LXe_OUTOFBOUNDS;
  end;
end;

function TArcTool.SetInt(Index : UInt32; Val : Integer) : LxResult;
begin
  Result := LXe_OK;

  case Index of
    ATTRa_SEGS : FSegments := Val;

    ATTRa_REVS : FReverse  := Val;
  else
    Result := LXe_OUTOFBOUNDS;
  end;
end;

function TArcTool.GetFlt(Index : UInt32; Val : PDouble) : LxResult;
begin
  Result := LXe_OK;

  case Index of
    ATTRa_CENX : Val^ := FCenter[0];
    ATTRa_CENY : Val^ := FCenter[1];
    ATTRa_CENZ : Val^ := FCenter[2];

    ATTRa_SRTX : Val^ := FStart[0];
    ATTRa_SRTY : Val^ := FStart[1];
    ATTRa_SRTZ : Val^ := FStart[2];

    ATTRa_ENDX : Val^ := FEnd[0];
    ATTRa_ENDY : Val^ := FEnd[1];
    ATTRa_ENDZ : Val^ := FEnd[2];

    ATTRa_RADI : Val^ := FRadius;
    ATTRa_ANGL : Val^ := FAngle;
  else
    Result := LXe_OUTOFBOUNDS;
  end;
end;

function TArcTool.SetFlt(Index : UInt32; Val : Double) : LxResult;
begin
  Result := LXe_OK;

  case Index of
    ATTRa_CENX : FCenter[0] := Val;
    ATTRa_CENY : FCenter[1] := Val;
    ATTRa_CENZ : FCenter[2] := Val;

    ATTRa_SRTX : begin
      FStart[0] := Val;
      SetRadius;
    end;
    ATTRa_SRTY : begin
      FStart[1] := Val;
      SetRadius;
    end;
    ATTRa_SRTZ : begin
      FStart[2] := Val;
      SetRadius;
    end;

    ATTRa_ENDX : begin
      FEnd[0] := Val;
      SetAngle;
    end;
    ATTRa_ENDY : begin
      FEnd[1] := Val;
      SetAngle;
    end;
    ATTRa_ENDZ : begin
      FEnd[2] := Val;
      SetAngle;
    end;

    ATTRa_RADI : begin
      FRadius := Val;
      SetRotHandles;
    end;

    ATTRa_ANGL : begin
      FAngle := Val;
      SetEndHandle;
    end
  else
    Result := LXe_OUTOFBOUNDS;
  end;
end;

function TArcTool.GetString(Index : UInt32; Val : PChar; Len : UInt32) : LxResult;
begin
  Result := LXe_NOTIMPL;
end;

function TArcTool.SetString(Index : UInt32; const Val : PChar) : LxResult;
begin
  Result := LXe_NOTIMPL;
end;

function TArcTool.UIHints(Index : UInt32; Hints_ : IUnknown) : LxResult;
var
  UIHints_ : ILxUIHints;
begin
  UIHints_ := Hints_ as ILxUIHints;

  with UIHints_ do
  begin
    case Index of
      ATTRa_RADI : MinFloat(0);

      ATTRa_ANGL : begin
        MinFloat(0);
        MaxFloat(LXx_PI);
      end;

      ATTRa_SEGS : MinInt(1);
    end;
  end;

  Result := LXe_OK;
end;

function TArcTool.UIValueHints(Index : UInt32; out VObj) : LxResult;
begin
  Result := LXe_NOTIMPL;
end;

function TArcTool.DisableMsg(Index : UInt32; Msg : IUnknown) : LxResult;
begin
  Result := LXe_NOTIMPL;
end;

procedure TArcTool.DrawHandles(VtS, Stroke : IUnknown; Flags_ : Integer);
var
  Pos, Color       : LXtVector;

  Mat              : LXtMatrix;

  LabelStr, NumStr : PChar;

  Angle            : Double;
  DFlags           : Integer;
  View             : PLXpToolViewEvent;

  Message          : ILxMessage;
  MessageService   : ILxMessageService;

  VectorStack : ILxVectorStack;
  HandleDraw  : ILxHandleDraw;
  StrokeDraw  : ILxStrokeDraw;
begin
  VectorStack := VtS as ILxVectorStack;

  VectorStack.Readable(FViewOffset, View);

  if not Assigned(View) or (View^.Type_ <> LXi_VIEWTYPE_3D) then
    Exit;

  Color := 0.8;
  PlaneMatrix(Mat);

  {
    Draw the center handle.
  }
  if FPart = ARC_HANDLE_CENTER then
    DFlags := LXi_THANDf_SMALL or LXi_THANDf_HOT
  else
    DFlags := LXi_THANDf_SMALL;

  HandleDraw := Stroke as ILxHandleDraw;
  StrokeDraw := Stroke as ILxStrokeDraw;
  GetService(ILxMessageService, MessageService);

  with HandleDraw, StrokeDraw, MessageService do
  begin
    Handle(FCenter, PLXtMatrix(nil)^, ARC_HANDLE_CENTER, DFlags);

    {
      Draw the start handle and the text at the start position.
    }
    if FPart = ARC_HANDLE_START then
      DFlags := LXi_THANDf_SMALL or LXi_THANDf_HOT
    else
      DFlags := LXi_THANDf_SMALL;

    RotateMouseHandle(FCenter, FStart, Mat, ARC_HANDLE_START, 2, DFlags);

    Allocate(Message);
    Message.SetMessage('prim.arc', 'rad', 0);
    Message.SetArgumentString(1, PChar(FloatToStr(FRadius)));

    LabelStr := GetMem(255);

    MessageText(Message, LabelStr, 255);

    GetPos(Pos, 0.0, 1.1);

    SetPart(LXiHITPART_INVIS);
    Begin_ (LXiSTROKE_TEXT, Color, 1.0);
    Text   (LabelStr, LXiTEXT_LEFT);
    Vertex (Pos, LXiSTROKE_ABSOLUTE);

    {
      Draw the end handle and the text at the center of the arc.
    }
    if FPart = ARC_HANDLE_END then
      DFlags := LXi_THANDf_SMALL or LXi_THANDf_HOT
    else
      DFlags := LXi_THANDf_SMALL;

    RotateMouseHandle(FCenter, FEnd, Mat, ARC_HANDLE_END, 2, DFlags);

    Allocate(Message);
    Message.SetMessage ('prim.arc', 'ang', 0);

    if FReverse = 1 then
      Angle := LXx_TWOPI - FAngle
    else
      Angle := FAngle;

    Message.SetArgumentString(1, PChar(FloatToStr(Angle * LXx_RAD2DEG)));
    MessageText(Message, LabelStr, 255);

    GetPos(Pos, 0.5, 1.1);

    SetPart(LXiHITPART_INVIS);
    Begin_ (LXiSTROKE_TEXT, Color, 1.0);
    Text   (LabelStr, LXiTEXT_LEFT);
    Vertex (Pos, LXiSTROKE_ABSOLUTE);
  end;
end;

procedure TArcTool.SetRadius;
begin
  FRadius := Len(FStart - FCenter);
end;

{
  Set the angle from the three handles.
}
procedure TArcTool.SetAngle;
var
  V0    ,
  V1    : LXtVector;
  VLen0 ,
  VLen1 ,
  X     : Double;
begin
  V0 := FStart - FCenter;
  V1 := FEnd - FCenter;

  VLen0 := Len(V0);
  VLen1 := Len(V1);

  if (VLen0 < 1.0e-10) or (VLen1 < 1.0e-10) then
    FAngle := 0
  else
  begin
    X      := Dot(V0, V1) / VLen0 / VLen1;
    X      := TVMath.LXxCLAMP(X, -1.0, 1.0);
    FAngle := ArcCos(X);
  end;
end;

{
  Set the start and end handle positions from the center and radius.
}
procedure TArcTool.SetRotHandles;
var
  Vec_ : LXtVector;
  Len_ : Double;
begin
  Vec_ := FStart - FCenter;
  Len_ := Len(Vec_);

  if Len_ > 0 then
  begin
   Vec_   := Vec_ * (FRadius / Len_);
   FStart := FCenter + Vec_;
  end;

  Vec_ := FEnd - FCenter;
  Len_ := Len(Vec_);

  if Len_ > 0 then
  begin
   Vec_ := Vec_ * (FRadius / Len_);
   FEnd := FCenter + Vec_;
  end;
end;

{
  Set the end handle position from the center and radius.
}
procedure TArcTool.SetEndHandle;
var
  Vec_  : LXtVector;
  Scale : Double;
begin
  Vec_  := FEnd - FCenter;
  Scale := Len(Vec_) / FRadius;

  GetPos(FEnd, 1.0, Scale);
end;

{
  method to compute a new matrix that encodes a rotation about an arbitrary axis.
  The angle is input as sine and cosine, which are sometimes easier to compute than
  the actual angle.
}
procedure MatrixAxisRotation(  out M    : LXtMatrix;
                             const A    : LXtVector;
                             const S, C : Double   ) ;
var
  T : Double;
begin
  T := 1.0 - C;
  M[0, 0] := T * A[0] * A[0] + C;
  M[0, 1] := T * A[0] * A[1] - S * A[2];
  M[0, 2] := T * A[0] * A[2] + S * A[1];
  M[1, 0] := T * A[1] * A[0] + S * A[2];
  M[1, 1] := T * A[1] * A[1] + C;
  M[1, 2] := T * A[1] * A[2] - S * A[0];
  M[2, 0] := T * A[2] * A[0] - S * A[1];
  M[2, 1] := T * A[2] * A[1] + S * A[0];
  M[2, 2] := T * A[2] * A[2] + C;
end;

{
  method for multiplying a vector times a matrix, in our unusual order.

  r = m * x;
}
procedure MatrixMultiply(  out R : LXtVector;
                         const M : LXtMatrix;
                         const X : LXtVector) ;
var
  I, J : Integer;
  D    : Double ;
begin
  for I := 0 to 2 do
  begin
    D := 0;

    for J := 0 to 2 do
      D := D + X[J] * M[I, J];

    R[I] := D;
  end;
end;

{
  Compute the arc position for the given fractional T.
}
procedure TArcTool.GetPos(  var Pos   : LXtVector;
                          const T     : Double   ;
                          const Scale : Double   ) ;
var
  Mat                 : LXtMatrix;
  Vec0, Vec1, Vec2    : LXtVector;
  Scale_, Len_, Angle : Double   ;
begin
  Vec0 := FStart - FCenter;
  Vec1 := FEnd - FCenter;
  TVMath.LXx_VCROSS(Vec2, Vec0, Vec1);
  Len_ := Len(Vec2);

  if Len_ > 0 then

    begin
      Scale_ := 1.0 / Len_;
      Vec2 := Vec2 * Scale_;

      if FReverse = 1 then
      begin
        Vec2  := -Vec2;
        Angle := (LXx_TWOPI - FAngle) * T;
      end
      else
        Angle := FAngle * T;

      MatrixAxisRotation(Mat, Vec2, Sin(Angle), Cos(Angle));
      Vec0 := Vec0 * Scale;
      MatrixMultiply(Pos, Mat, Vec0);
      Pos := Pos + FCenter;
    end

  else

    Pos := FStart;
end;

procedure TArcTool.PlaneMatrix(out Mat : LXtMatrix);
var
  X, Y, Z     : LXtVector;
  Len_, Scale : Double   ;
begin
  X := FStart - FCenter;
  Y := FEnd - FCenter;
  TVMath.LXx_VCROSS(Z, X, Y);
  Len_ := Len(Z);

  if Len_ > 0 then
  begin
    Scale := 1.0 / Len_;
    Z := Z * Scale;
    Scale := 1.0 / Len(X);
    X := X * Scale;
    TVMath.LXx_VCROSS(Y, Z, X);
    Mat[0, 0] := X[0];
    Mat[1, 0] := X[1];
    Mat[2, 0] := X[2];
    Mat[0, 1] := Y[0];
    Mat[1, 1] := Y[1];
    Mat[2, 1] := Y[2];
    Mat[0, 2] := Z[0];
    Mat[1, 2] := Z[1];
    Mat[2, 2] := Z[2];
  end
  else
  begin
    Mat[0, 0] := 1;
    Mat[1, 1] := 1;
    Mat[2, 2] := 1;

    Mat[0, 1] := 0;
    Mat[0, 2] := 0;
    Mat[1, 0] := 0;
    Mat[1, 2] := 0;
    Mat[2, 0] := 0;
    Mat[2, 1] := 0;
  end;
end;

initialization
  AddServer('prim.arc', TArcTool, [nil]);
end.
